home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / sptmbr11.lha / clx / demo / zoid.lisp < prev   
Lisp/Scheme  |  1992-06-12  |  2KB  |  59 lines
  1. ;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
  2.  
  3. ;;; CLX interface for Trapezoid Extension.
  4.  
  5. ;;;
  6. ;;;             TEXAS INSTRUMENTS INCORPORATED
  7. ;;;                  P.O. BOX 2909
  8. ;;;                   AUSTIN, TEXAS 78769
  9. ;;;
  10. ;;; Copyright (C) 1987 Texas Instruments Incorporated.
  11. ;;;
  12. ;;; Permission is granted to any individual or institution to use, copy, modify,
  13. ;;; and distribute this software, provided that this complete copyright and
  14. ;;; permission notice is maintained, intact, in all copies and supporting
  15. ;;; documentation.
  16. ;;;
  17. ;;; Texas Instruments Incorporated provides this software "as is" without
  18. ;;; express or implied warranty.
  19. ;;;
  20.  
  21. (in-package :xlib)
  22.  
  23. (export '(draw-filled-trapezoids
  24.        gcontext-trapezoid-alignment ;; Setf'able
  25.        ))
  26.  
  27. (define-extension "ZoidExtension")
  28.  
  29. (defun draw-filled-trapezoids (drawable gcontext points)
  30.   ;; Draw trapezoids on drawable using gcontext.
  31.   ;; Points are a list of either (y1 y2 y3 y4 x1 x2) ;; x-aligned
  32.   ;;                      or     (x1 x2 x3 x4 y1 y2) ;; y-aligned
  33.   ;; Alignment is determined by the GCONTEXT [see gcontext-trapezoid-alignment]
  34.   ;; Alignment is set with the ALIGNMENT keyword argument, which may be
  35.   ;; :X, :Y, or NIL (use previous alignment)
  36.   (declare (type drawable drawable)
  37.        (type gcontext gcontext)
  38.        (type sequence points))
  39.   (let* ((display (drawable-display drawable))
  40.      (opcode (extension-opcode display "ZoidExtension")))
  41.     (with-buffer-request (display opcode :gc-force gcontext)
  42.       ((data card8) 1) ;; X_PolyFillZoid
  43.       (drawable drawable)
  44.       (gcontext gcontext)
  45.       ((sequence :format int16) points))))
  46.  
  47. (define-gcontext-accessor trapezoid-alignment :default :x
  48.   :set-function set-trapezoid-alignment)
  49.  
  50. (defun set-trapezoid-alignment (gcontext alignment)
  51.   (declare (type (member :x :y) alignment))
  52.   (let* ((display (gcontext-display gcontext))
  53.      (opcode (extension-opcode display "ZoidExtension")))
  54.     (with-buffer-request (display opcode)
  55.       ((data card8) 2) ;; X_SetZoidAlignment
  56.       (gcontext gcontext)
  57.       ((member8 %error :x :y) alignment))))
  58.  
  59.